Plotting function to reduce code length + simplify. Then, short function to place MLS weight smoothing kernel into same category to make visually consistent, updates are:
create_plot <- function(dataset, type, thresh) {
plot <- dataset %>%
ggplot(aes(x = .data[[type]], y = median_est, fill = .data[[type]], color = .data[[type]])) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
facet_grid(~study) +
theme_classic() +
ggtitle(paste("Distribution by",type,"category (",thresh,"mask)")) +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10, angle = 45, hjust = 1),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
return(plot)
}
update_mls_fwhm <- function(df) {
df <- df %>%
mutate(fwhm = case_when(
fwhm == "fwhm-3.0" ~ "fwhm-3.6",
fwhm == "fwhm-4.0" ~ "fwhm-4.8",
fwhm == "fwhm-5.0" ~ "fwhm-6.0",
fwhm == "fwhm-6.0" ~ "fwhm-7.2",
fwhm == "fwhm-7.0" ~ "fwhm-8.4",
TRUE ~ as.character(fwhm) # if none of the conditions match, keep the original value
))
return(df)
}
create_specr_plot <- function(summary_df, est_label) {
plot_a = plot_curve(df = summary_df, ci = TRUE, desc = FALSE, legend = FALSE, null = 0)
plot_b <- plot_choices(df = summary_df, choices = c("fwhm", "motion","contrast","model"), desc = F, null = 0) +
labs(y = "Variables", x = paste("Ordered Specification Curve \n",est_label, "coefficient"))
cowplot::plot_grid(plot_a, plot_b, ncol = 1, align = "v", axis = 'tblr',
labels = c('A', 'B'), rel_heights = c(1, 2),
label_fontfamily = "Times", label_size = 12)
}
calculate_summary_stats <- function(data, variable, est_type) {
data %>%
select(study, {{variable}}) %>%
group_by(study) %>%
summarise(
"est_type" = est_type,
"median" = median({{variable}}),
"sd" = sd({{variable}}),
"min" = min({{variable}}),
"max" = max({{variable}})
) %>%
kbl(format = "html",
booktabs = TRUE) %>%
kable_styling(full_width = FALSE)
}The packages are automatically loaded using pacman. The
reported .html was last ran on the system: x86_64-apple-darwin17.0 and R
version: R version 4.2.1 (2022-06-23) In the
Stage 1 PCI Registered
Report we are focused on Individual Continues (intraclass
correlation) and the binary/continuoues group similarity (jaccard and
spearman). Related to the descriptive file here, we describe each step
that contained within this file that is relevant to the registered
analyses
continuous
We stated:
Aim1: the range and distribution of median ICCs across each study (three) and analytic decision category (four) are plotted across suprathreshold task-positive and subthreshold ICCs using Rainclouds (Allen et al., 2019) and the median and standard deviation is reported in a table.
to visualize the ordered median ICCs across the 360 model permutations for suprathreshold task-positive and subthreshold ICCs, specification curve analyses are used (Simonsohn et al., 2020). Specifically, results across the 360 model permutations are reported using a specification curve to represent the range of estimated effects across the variable permutations. This consists of two panels: Panel A represents the ordered ICC coefficients and the ICC’s associated 95% confidence interval colored based on no significance (gray), negative (red) or positive (blue) significance from the Null (Null here is 0) and Panel B represents the analytic decisions from each of the four categories (see Table 1) that produced the median ICC estimates. In the main text, to compare the highest and lowest ICC’s produced by the model permutations, the 25th percentile and 75th percentile median ICC estimates from the 360 models are reported separately for suprathreshold task-positive and subthreshold activation (the specification curve for all ICC estimates for suprathreshold task-positive and subthreshold activation are provided as supplemental information).
Aim2: the range and distribution of median MSBS and MSWS across each study and analytic decision category are plotted across suprathreshold task-positive and subthreshold ICCs using Rainclouds.
two separate specification curve analyses report the ordered median MSBS and MSWS coefficients in one panel and the analytic decisions that produced the MSBS and MSWS estimates in a second panel separately for suprathreshold task-positive and subthreshold activation
group similarity
We stated:
Aim1: For each study, the coefficients are plotted to reflect the distribution and range of coefficients. Both Jaccard’s and Spearman correlation are reported separately.
# ABCD NDA DATA Info
abcd_nda$subject <- abcd_nda$participant_id
abcd_nda$subject <- gsub("_", "", abcd_nda$subject)
abcd_nda$session <- abcd_nda$eventname
abcd_nda$session <- gsub('2_year_follow_up_y_arm_1', '2YearFollowUpYArm1', abcd_nda$session)
abcd_nda$session <- gsub('baseline_year_1_arm_1', 'baselineYear1Arm1', abcd_nda$session)
abcd_nda_subset <- abcd_nda %>%
filter(subject %in% abcd_site13_ids$V1) %>%
select(!c(subjectkey,eventname))
abcd_days <- abcd_nda_subset %>%
mutate(date_r = as.Date(interview_date, format = "%m/%d/%Y")) %>%
group_by(subject) %>%
arrange(date_r) %>%
mutate(days_btwn_scans = as.integer(diff(date_r))) %>%
select(days_btwn_scans, subject, interview_age,sex)
colnames(abcd_days) <- c("days","subject","Age","Sex")
abcd_days$sample <- "ABCD"
rm(abcd_nda,abcd_site13_ids)Plot distribution of days between scans
dur_scans %>%
ggplot(aes(x = subject, y = days, fill = sample, color="white")) +
geom_bar(stat = 'identity', position = 'dodge') +
ylab("Days between scans") +
xlab("") +
scale_fill_manual(values = pal) +
scale_color_manual(values = "white") +
theme_minimal() +
theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(), text = element_text(family = "Times New Roman")) +
facet_grid(~sample, scales = 'free_x') +
guides(fill = FALSE, color = FALSE, scale = "none")## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
dur_scans %>%
group_by(sample) %>%
summarise(
"Sample (N)" = n(),
"Avg Days Between Scans" = mean(days),
"SD Days Between Scans" = sd(days)
) %>%
kbl(format = "html",
booktabs = TRUE) %>%
kable_styling(full_width = FALSE)| sample | Sample (N) | Avg Days Between Scans | SD Days Between Scans |
|---|---|---|---|
| ABCD | 130 | 745.9538 | 78.92837 |
| AHRB | 60 | 419.4167 | 80.13660 |
| MLS | 81 | 1088.7037 | 623.50815 |
demo_comb <- rbind(abcd_days %>% distinct(subject, .keep_all = TRUE) %>%
mutate(sample = "ABCD", Age = round(Age/12,2)) %>% select(sample, subject,Age, Sex, days),
ahrb_demo_subset %>%
mutate(sample = "AHRB", Sex = if_else(sex==0,"F","M")) %>%
rename("Age"= age, "subject" = participant_id) %>% select(sample, subject,Age,Sex, days),
mls_demo_subset %>%
mutate(sample = "MLS", Age = round(if_else(is.na(reward_days_ses1toses2),
((ScanAge * 365) + reward_ses2toses3) / 365,
ScanAge),1),
Sex = if_else(Sex==1,"F","M")) %>%
rename("subject" = participant_id) %>% select(sample, subject,Age,Sex, days)
)
table1(~Age + factor(Sex) + days | sample, data = demo_comb)| ABCD (N=130) |
AHRB (N=60) |
MLS (N=81) |
Overall (N=271) |
|
|---|---|---|---|---|
| Age | ||||
| Mean (SD) | 9.81 (0.573) | 19.3 (1.30) | 20.7 (2.26) | 15.1 (5.35) |
| Median [Min, Max] | 9.83 [9.00, 11.0] | 19.2 [17.2, 21.4] | 20.2 [18.0, 26.8] | 17.5 [9.00, 26.8] |
| factor(Sex) | ||||
| F | 70 (53.8%) | 35 (58.3%) | 31 (38.3%) | 136 (50.2%) |
| M | 60 (46.2%) | 25 (41.7%) | 50 (61.7%) | 135 (49.8%) |
| days | ||||
| Mean (SD) | 746 (78.9) | 419 (80.1) | 1090 (624) | 776 (421) |
| Median [Min, Max] | 725 [648, 1070] | 391 [352, 692] | 756 [332, 2970] | 712 [332, 2970] |
Below, running the steps to summarize the different Intraclass correlation (ICC), Mean Squared Between Subject (MSBS), Mean Square Within Subject (MSWS), and jaccard and spearman similarty for the model combinations 360 across samples
Plotting overall and for each of [four] categories
Creating rainclouds via ggrain
fwhm_rg = create_plot(icc_subthresh, "fwhm","sub-threshold")
motion_rg = create_plot(icc_subthresh, "motion","sub-threshold")
modeltype_rg = create_plot(icc_subthresh, "model","sub-threshold")
contrast_rg = create_plot(icc_subthresh, "con","sub-threshold")
fwhm_rg## Warning: Using the `size` aesthetic in this geom was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` in the `default_aes` field and elsewhere instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
fwhm_rg = create_plot(icc_suprathresh, "fwhm","supra-threshold")
motion_rg = create_plot(icc_suprathresh, "motion","supra-threshold")
modeltype_rg = create_plot(icc_suprathresh, "model","supra-threshold")
contrast_rg = create_plot(icc_suprathresh, "con","supra-threshold")
fwhm_rgPlotting overall and for each of [four] categories
fwhm_rg = create_plot(bs_subthresh, "fwhm","sub-threshold")
motion_rg = create_plot(bs_subthresh, "motion","sub-threshold")
modeltype_rg = create_plot(bs_subthresh, "model","sub-threshold")
contrast_rg = create_plot(bs_subthresh, "con","sub-threshold")
fwhm_rgfwhm_rg = create_plot(bs_suprathresh, "fwhm","supra-threshold")
motion_rg = create_plot(bs_suprathresh, "motion","supra-threshold")
modeltype_rg = create_plot(bs_suprathresh, "model","supra-threshold")
contrast_rg = create_plot(bs_suprathresh, "con","supra-threshold")
fwhm_rgPlotting overall and for each of [four] categories
fwhm_rg = create_plot(ws_subthresh, "fwhm","sub-threshold")
motion_rg = create_plot(ws_subthresh, "motion","sub-threshold")
modeltype_rg = create_plot(ws_subthresh, "model","sub-threshold")
contrast_rg = create_plot(ws_subthresh, "con","sub-threshold")
fwhm_rgfwhm_rg = create_plot(ws_suprathresh, "fwhm","supra-threshold")
motion_rg = create_plot(ws_suprathresh, "motion","supra-threshold")
modeltype_rg = create_plot(ws_suprathresh, "model","supra-threshold")
contrast_rg = create_plot(ws_suprathresh, "con","supra-threshold")
fwhm_rgfwhm_rg = similarity_df %>% ggplot(aes(x = fwhm, y = jaccard, fill = fwhm, color = fwhm)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
theme_classic() +
facet_grid(~study) +
ggtitle("Distribution by FWHN category (Jaccard)") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
motion_rg = similarity_df %>% ggplot(aes(x = motion, y = jaccard, fill = motion, color = motion)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
facet_grid(~study) +
theme_classic() +
ggtitle("Distribution by Motion category (Jaccard)") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
modeltype_rg = similarity_df %>% ggplot(aes(x = model, y = jaccard, fill = model, color = model)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
facet_grid(~study) +
theme_classic() +
ggtitle("Distribution by Model Type category (Jaccard)") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
contrast_rg = similarity_df %>% ggplot(aes(x = con, y = jaccard, fill = con, color = con)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
facet_grid(~study) +
theme_classic() +
ggtitle("Distribution by Contrast category (Jaccard)") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10, angle = 45, hjust = 1),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
fwhm_rgfwhm_rg = similarity_df %>% ggplot(aes(x = fwhm, y = spearman, fill = fwhm, color = fwhm)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
facet_grid(~study) +
theme_classic() +
ggtitle("Distribution by FWHN category (spearman)") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
motion_rg = similarity_df %>% ggplot(aes(x = motion, y = spearman, fill = motion, color = motion)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
facet_grid(~study) +
theme_classic() +
ggtitle("Distribution by Motion category (spearman)") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
modeltype_rg = similarity_df %>% ggplot(aes(x = model, y = spearman, fill = model, color = model)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
facet_grid(~study) +
theme_classic() +
ggtitle("Distribution by Model Type category (spearman)") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
contrast_rg = similarity_df %>% ggplot(aes(x = con, y = spearman, fill = con, color = con)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .1), width = 0.1
)) +
facet_grid(~study) +
theme_classic() +
ggtitle("Distribution by Contrast category (spearman)") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10, angle = 45, hjust = 1),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))
fwhm_rgcohens_sim <- gather(similarity_df, key = "Run", value = "spearman", ses1_icc_cohensd:ses2_icc_cohensd) %>%
mutate(Run = case_when(
Run == "ses1_icc_cohensd" ~ "Run1",
Run == "ses_icc_cohensd" ~ "Run2",
TRUE ~ Run
))cohens_sim %>% ggplot(aes(x = fwhm, y = spearman, fill = fwhm, color = fwhm)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .2), width = 0.1
)) +
facet_grid(~study + Run) +
theme_classic() +
ggtitle("Distribution by FWHM category") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10, angle = 45, hjust = 1),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))cohens_sim %>% ggplot(aes(x = con, y = spearman, fill = con, color = con)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .2), width = 0.1
)) +
facet_grid(~study + Run) +
theme_classic() +
ggtitle("Distribution by Contrast category") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10, angle = 45, hjust = 1),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))cohens_sim %>% ggplot(aes(x = motion, y = spearman, fill = motion, color = motion)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .2), width = 0.1
)) +
facet_grid(~study + Run) +
theme_classic() +
ggtitle("Distribution by Motion category") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10, angle = 45, hjust = 1),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))cohens_sim %>% ggplot(aes(x = model, y = spearman, fill = model, color = model)) +
geom_rain(alpha = .5, rain.side = 'l',
boxplot.args = list(color = "black", outlier.shape = NA),
boxplot.args.pos = list(
position = ggpp::position_dodgenudge(x = .2), width = 0.1
)) +
facet_grid(~study + Run) +
theme_classic() +
ggtitle("Distribution by Model category") +
scale_fill_manual(values = pal) +
scale_color_manual(values = pal) +
guides(fill = 'none', color = 'none') +
theme(text = element_text(family = "Times New Roman"),
axis.text = element_text(size = 10, angle = 45, hjust = 1),
axis.title = element_text(size = 10),
legend.text = element_text(size = 10),
legend.title = element_text(size = 10),
plot.title = element_text(size = 16))## Subthreshold mask
## ICC, MSBS and MSWS median, miniumum and maximum
| study | est_type | median | sd | min | max |
|---|---|---|---|---|---|
| abcd | ICC | 0.0795 | 0.0878043 | 0.003 | 0.321 |
| ahrb | ICC | 0.1260 | 0.0878269 | 0.041 | 0.402 |
| mls | ICC | 0.1310 | 0.0665285 | 0.037 | 0.320 |
| study | est_type | median | sd | min | max |
|---|---|---|---|---|---|
| abcd | MSBS | 0.8530 | 0.7354776 | 0.090 | 4.174 |
| ahrb | MSBS | 0.2935 | 0.3249359 | 0.035 | 1.823 |
| mls | MSBS | 0.6500 | 0.8990915 | 0.051 | 3.788 |
| study | est_type | median | sd | min | max |
|---|---|---|---|---|---|
| abcd | MSWS | 0.6275 | 0.4651668 | 0.084 | 2.386 |
| ahrb | MSWS | 0.1900 | 0.1612192 | 0.027 | 0.932 |
| mls | MSWS | 0.4665 | 0.4800625 | 0.041 | 2.074 |
## Suprathreshold mask
## ICC, MSBS and MSWS median, miniumum and maximum
| study | est_type | median | sd | min | max |
|---|---|---|---|---|---|
| abcd | ICC | 0.1140 | 0.1143492 | 0.022 | 0.433 |
| ahrb | ICC | 0.2090 | 0.1277304 | 0.043 | 0.532 |
| mls | ICC | 0.2055 | 0.0969472 | 0.058 | 0.473 |
| study | est_type | median | sd | min | max |
|---|---|---|---|---|---|
| abcd | MSBS | 0.6140 | 0.5201279 | 0.062 | 2.925 |
| ahrb | MSBS | 0.1980 | 0.2168676 | 0.022 | 1.167 |
| mls | MSBS | 0.4115 | 0.6058191 | 0.029 | 2.594 |
| study | est_type | median | sd | min | max |
|---|---|---|---|---|---|
| abcd | MSWS | 0.432 | 0.3058086 | 0.056 | 1.636 |
| ahrb | MSWS | 0.122 | 0.0986517 | 0.017 | 0.555 |
| mls | MSWS | 0.280 | 0.2902648 | 0.024 | 1.235 |
## Similarity median, minimum and maximum for jaccard and spearman
| study | est_type | median | sd | min | max |
|---|---|---|---|---|---|
| ahrb | Jaccard | 0.3037331 | 0.1853570 | 0.0395941 | 0.7281375 |
| mls | Jaccard | 0.4178440 | 0.1234524 | 0.1979287 | 0.7410373 |
| study | est_type | median | sd | min | max |
|---|---|---|---|---|---|
| ahrb | Spearman | 0.8243898 | 0.2085670 | 0.3161175 | 0.9695884 |
| mls | Spearman | 0.8712244 | 0.0910636 | 0.5911072 | 0.9723035 |
Creating data in a format that is compatible with specr. Needs: estimate (i.e., ICC), std.error, conf.high, conf.low.
creating combined panel 1 and panel 2 for all model permutations first.
# first, combine independent model vars into string to create average for each model type
icc_suprathresh$model_type <- paste(icc_suprathresh$fwhm, icc_suprathresh$motion,
icc_suprathresh$con, icc_suprathresh$model,
sep = "_")
# calculate the avg estimate of ICC across study, standard error and +/- 95% confidence interval. In complete version
df_summ <- icc_suprathresh %>%
group_by(model_type) %>%
summarise(estimate = mean(median_est), std.error = sd(median_est)/sqrt(length(median_est))) %>%
mutate(conf.low = estimate - 1.96 * std.error, conf.high = estimate + 1.96 * std.error) %>%
separate(col = model_type, into = c("fwhm","motion","contrast","model"), sep = "_|-", remove = FALSE)
# plot
est_label = "supra-threshod ICC"
create_specr_plot(df_summ, est_label)Creating model that is subset to visualize reliability for the top (>75th) and bottom (< 25th) quartile
# get 75th/25th qunatiles
top_75q = as.numeric(quantile(df_summ$estimate, .75))
bot_25q = as.numeric(quantile(df_summ$estimate, .25))
df_summ_subset = df_summ %>%
filter(estimate < bot_25q | estimate > top_75q)
# subset plots
est_label = "supra-threshold ICC"
create_specr_plot(df_summ_subset, est_label)creating combined panel 1 and panel 2 for all model permutations first.
icc_subthresh$model_type <- paste(icc_subthresh$fwhm, icc_subthresh$motion,
icc_subthresh$con, icc_subthresh$model,
sep = "_")
df_summ <- icc_subthresh %>%
group_by(model_type) %>%
summarise(estimate = mean(median_est), std.error = sd(median_est)/sqrt(length(median_est))) %>%
mutate(conf.low = estimate - 1.96 * std.error, conf.high = estimate + 1.96 * std.error) %>%
separate(col = model_type, into = c("fwhm","motion","contrast","model"), sep = "_|-", remove = FALSE)
# plot
est_label = "sub-threshold ICC"
create_specr_plot(df_summ, est_label)Creating model that is subset to visualize reliability for the top (>75th) and bottom (< 25th) quartile
# get 75th/25th qunatiles
top_75q = as.numeric(quantile(df_summ$estimate, .75))
bot_25q = as.numeric(quantile(df_summ$estimate, .25))
df_summ_subset = df_summ %>%
filter(estimate < bot_25q | estimate > top_75q)
# subset plots
est_label = "sub-threshold ICC"
create_specr_plot(df_summ_subset, est_label)creating combined panel 1 and panel 2 for all model permutations first.
bs_suprathresh$model_type <- paste(bs_suprathresh$fwhm, bs_suprathresh$motion,
bs_suprathresh$con, bs_suprathresh$model,
sep = "_")
df_summ <- bs_suprathresh %>%
group_by(model_type) %>%
summarise(estimate = mean(median_est), std.error = sd(median_est)/sqrt(length(median_est))) %>%
mutate(conf.low = estimate - 1.96 * std.error, conf.high = estimate + 1.96 * std.error) %>%
separate(col = model_type, into = c("fwhm","motion","contrast","model"), sep = "_|-", remove = FALSE)
# plot
est_label = "supra-threshold MSBS"
create_specr_plot(df_summ, est_label)Creating model that is subset to visualize reliability for the top (>75th) and bottom (< 25th) quartile
# get 75th/25th qunatiles
top_75q = as.numeric(quantile(df_summ$estimate, .75))
bot_25q = as.numeric(quantile(df_summ$estimate, .25))
df_summ_subset = df_summ %>%
filter(estimate < bot_25q | estimate > top_75q)
# subset plots
est_label = "supra-threshold MSBS"
create_specr_plot(df_summ_subset, est_label)creating combined panel 1 and panel 2 for all model permutations first.
bs_subthresh$model_type <- paste(bs_subthresh$fwhm, bs_subthresh$motion,
bs_subthresh$con, bs_subthresh$model,
sep = "_")
df_summ <- bs_subthresh %>%
group_by(model_type) %>%
summarise(estimate = mean(median_est), std.error = sd(median_est)/sqrt(length(median_est))) %>%
mutate(conf.low = estimate - 1.96 * std.error, conf.high = estimate + 1.96 * std.error) %>%
separate(col = model_type, into = c("fwhm","motion","contrast","model"), sep = "_|-", remove = FALSE)
# plot
est_label = "sub-threshold MSBS"
create_specr_plot(df_summ, est_label)Creating model that is subset to visualize reliability for the top (>75th) and bottom (< 25th) quartile
# get 75th/25th qunatiles
top_75q = as.numeric(quantile(df_summ$estimate, .75))
bot_25q = as.numeric(quantile(df_summ$estimate, .25))
df_summ_subset = df_summ %>%
filter(estimate < bot_25q | estimate > top_75q)
# subset plots
est_label = "suprathreshold MSBS"
create_specr_plot(df_summ_subset, est_label)creating combined panel 1 and panel 2 for all model permutations first.
ws_suprathresh$model_type <- paste(ws_suprathresh$fwhm, ws_suprathresh$motion,
bs_suprathresh$con, ws_suprathresh$model,
sep = "_")
df_summ <- ws_suprathresh %>%
group_by(model_type) %>%
summarise(estimate = mean(median_est), std.error = sd(median_est)/sqrt(length(median_est))) %>%
mutate(conf.low = estimate - 1.96 * std.error, conf.high = estimate + 1.96 * std.error) %>%
separate(col = model_type, into = c("fwhm","motion","contrast","model"), sep = "_|-", remove = FALSE)
# plot
est_label = "supra-threshold MSWS"
create_specr_plot(df_summ, est_label)Creating model that is subset to visualize reliability for the top (>75th) and bottom (< 25th) quartile
# get 75th/25th qunatiles
top_75q = as.numeric(quantile(df_summ$estimate, .75))
bot_25q = as.numeric(quantile(df_summ$estimate, .25))
df_summ_subset = df_summ %>%
filter(estimate < bot_25q | estimate > top_75q)
# subset plots
est_label = "supra-threshold MSWS"
create_specr_plot(df_summ_subset, est_label)creating combined panel 1 and panel 2 for all model permutations first.
ws_subthresh$model_type <- paste(ws_subthresh$fwhm, ws_subthresh$motion,
ws_subthresh$con, ws_subthresh$model,
sep = "_")
# calculate the avg estimate of ICC across study, standard error and +/- 95% confidence interval. In complete version
df_summ <- ws_subthresh %>%
group_by(model_type) %>%
summarise(estimate = mean(median_est), std.error = sd(median_est)/sqrt(length(median_est))) %>%
mutate(conf.low = estimate - 1.96 * std.error, conf.high = estimate + 1.96 * std.error) %>%
separate(col = model_type, into = c("fwhm","motion","contrast","model"), sep = "_|-", remove = FALSE)
# plot
est_label = "sub-threshold MSWS"
create_specr_plot(df_summ, est_label)Creating model that is subset to visualize reliability for the top (>75th) and bottom (< 25th) quartile
# get 75th/25th qunatiles
top_75q = as.numeric(quantile(df_summ$estimate, .75))
bot_25q = as.numeric(quantile(df_summ$estimate, .25))
df_summ_subset = df_summ %>%
filter(estimate < bot_25q | estimate > top_75q)
# subplot
est_label = "sub-threshold MSWS"
create_specr_plot(df_summ_subset, est_label)creating combined panel 1 and panel 2 for all model permutations first.
similarity_df$model_type <- paste(similarity_df$fwhm, similarity_df$motion,
similarity_df$con, similarity_df$model,
sep = "_")
df_summ <- similarity_df %>%
group_by(model_type) %>%
summarise(estimate = mean(jaccard), std.error = sd(jaccard)/sqrt(length(jaccard))) %>%
mutate(conf.low = estimate - 1.96 * std.error, conf.high = estimate + 1.96 * std.error) %>%
separate(col = model_type, into = c("fwhm","motion","contrast","model"), sep = "_|-", remove = FALSE)
# plot
est_label = "Jaccard"
create_specr_plot(df_summ, est_label)Creating model that is subset to visualize reliability for the top (>75th) and bottom (< 25th) quartile
# get 75th/25th qunatiles
top_75q = as.numeric(quantile(df_summ$estimate, .75))
bot_25q = as.numeric(quantile(df_summ$estimate, .25))
df_summ_subset = df_summ %>%
filter(estimate < bot_25q | estimate > top_75q)
# subset plots
est_label = "Jaccard"
create_specr_plot(df_summ_subset, est_label)creating combined panel 1 and panel 2 for all model permutations first.
similarity_df$model_type <- paste(similarity_df$fwhm, similarity_df$motion,
similarity_df$con, similarity_df$model,
sep = "_")
# calculate the avg estimate of ICC across study, standard error and +/- 95% confidence interval. In complete version
df_summ <- similarity_df %>%
group_by(model_type) %>%
summarise(estimate = mean(spearman), std.error = sd(spearman)/sqrt(length(spearman))) %>%
mutate(conf.low = estimate - 1.96 * std.error, conf.high = estimate + 1.96 * std.error) %>%
separate(col = model_type, into = c("fwhm","motion","contrast","model"), sep = "_|-", remove = FALSE)
# plot
est_label = "Spearman"
create_specr_plot(df_summ, est_label)Creating model that is subset to visualize reliability for the top (>75th) and bottom (< 25th) quartile
# get 75th/25th qunatiles
top_75q = as.numeric(quantile(df_summ$estimate, .75))
bot_25q = as.numeric(quantile(df_summ$estimate, .25))
df_summ_subset = df_summ %>%
filter(estimate < bot_25q | estimate > top_75q)
# subset plots
est_label = "Spearman"
create_specr_plot(df_summ_subset, est_label)